year <- lubridate::year(Sys.Date())
week <- lubridate::week(Sys.Date())
plots_dir <- paste0("plots/", year, "-", week)
fs::dir_create(plots_dir)
png_file <- "2022-25_Juneteenth.png"
pdf_file <- "2022-25_Juneteenth.pdf"
## packages
library(tidyverse)
library(janitor)
library(scales)
library(ggtext)
library(patchwork)
library(showtext)
font_add_google(name = "IBM Plex Sans", family = "ibm-plex-sans")
showtext_opts(dpi = 300)
showtext_auto(enable = TRUE)
tuesdata <- tidytuesdayR::tt_load(year, week = week)
## --- Compiling #TidyTuesday Information for 2022-06-21 ----
## --- There are 6 files available ---
## --- Starting Download ---
##
## Downloading file 1 of 6: `african_names.csv`
## Downloading file 2 of 6: `slave_routes.csv`
## Downloading file 3 of 6: `blackpast.csv`
## Downloading file 4 of 6: `firsts.csv`
## Downloading file 5 of 6: `science.csv`
## Downloading file 6 of 6: `census.csv`
## --- Download complete ---
firsts <- tuesdata$firsts
# blackpast <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/blackpast.csv')
# census <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/census.csv')
# slave_routes <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/slave_routes.csv')
# african_names <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-06-16/african_names.csv')
firsts %>%
count(category)
## # A tibble: 8 × 2
## category n
## <chr> <int>
## 1 Arts & Entertainment 107
## 2 Education & Science 87
## 3 Law 14
## 4 Military 73
## 5 Politics 82
## 6 Religion 21
## 7 Social & Jobs 57
## 8 Sports 38
firsts_tbl <- firsts %>%
filter(year > 1799) %>%
filter(year < 1900) %>%
mutate(person = str_replace_all(person, "\\[[0-9]+\\]", ""),
person = str_replace_all(person, "\\[Note [0-9]+\\]", ""),
person = str_remove(person, " \\(See also"),
person = str_remove(person, ", renamed Lincoln University.+$"),
person = str_remove(person, ", who was educated at the University.+$"),
person = str_remove(person, ", based in Philadelphia.+$"),
person = str_remove(person, " founded in Philadelphia.+$"),
person = str_remove(person, ", Belgium.+$"),
person = str_remove(person, ", The Laughing.+$"),
person = str_remove(person, ", hired by.+$"),
person = str_remove(person, " His opponent contested.+$"),
person = str_remove(person, ", then living.+$"),
person = str_remove(person, "; Xenia.+$"),
person = str_remove(person, "founded in New York City by "),
person = str_replace_all(person, " \\(.+\\)", ""),
person = str_remove(person, "\\.$"),
accomplishment = str_remove(accomplishment, "First African-American"),
accomplishment = str_remove(accomplishment, "^First "),
accomplishment = str_remove(accomplishment, "African-American "),
accomplishment = str_replace(accomplishment, "woman", "female")
) %>%
group_by(year) %>%
sample_n(1)
black <- "#000000"
brown <- "#654321"
tan <- "#d2b48c"
gold <- "#ffd700"
pink <- "#ffc0cb"
crimson <- "#dc143c"
green <- "#00aa00"
blue <- "#4682b4"
fill_cols <- c(
"Religion" = crimson,
"Education & Science" = brown,
"Law" = blue,
"Military" = green,
"Politics" = black,
"Social & Jobs" = pink,
"Sports" = gold,
"Arts & Entertainment" = tan
)
subtitle <- "FIRST AFRICAN-AMERICAN ..."
title <-
"African-American accomplishments in the nineteenth century"
caption <- "Source: adapted from Wikipedia"
plt_1 <-
firsts_tbl %>%
ggplot() +
geom_hline(aes(yintercept = 0), linetype = 2) +
geom_label(
aes(
x = year,
y = 0,
label = year,
fill = category
),
color = "white",
label.r = unit(0.5, "lines"),
) +
scale_fill_manual(values = fill_cols) +
geom_text(aes(x = year, y = .5, label = person),
hjust = "left",
size = 4) +
geom_text(aes(x = year, y = -.5, label = accomplishment),
hjust = "right",
size = 4) +
scale_x_reverse() +
scale_y_continuous(limits = c(-5, 5)) +
labs(
title = title,
subtitle = subtitle,
caption = caption,
x = NULL,
y = NULL
) +
coord_flip() +
theme_minimal() +
theme(
text = element_text(family = "ibm-plex-sans"),
plot.title = element_text(
family = "ibm-plex-sans",
size = 20,
hjust = 0.5
),
plot.subtitle = element_text(
family = "ibm-plex-sans",
face = "bold",
size = 28,
hjust = 0.5
),
axis.text = element_blank(),
axis.line = element_blank(),
panel.grid = element_blank(),
plot.background = element_rect(fill = "#ede5dc"),
legend.position = "bottom"
)
plt_1 + plot_layout(ncol = 1)
ggsave(here::here(plots_dir, pdf_file),
width = 12, height = 20, dpi = 300,
device = cairo_pdf)
ggsave(here::here(plots_dir, png_file),
width = 12, height = 20, dpi = 300,
device = "png")
sessionInfo()
## R version 4.2.0 (2022-04-22)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Linux Mint 20.3
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
## [5] LC_MONETARY=nl_NL.UTF-8 LC_MESSAGES=en_US.UTF-8
## [7] LC_PAPER=nl_NL.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=nl_NL.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] showtext_0.9-5 showtextdb_3.0 sysfonts_0.8.8 patchwork_1.1.1
## [5] ggtext_0.1.1 scales_1.2.0 janitor_2.1.0 forcats_0.5.1
## [9] stringr_1.4.0 dplyr_1.0.9 purrr_0.3.4 readr_2.1.2
## [13] tidyr_1.2.0 tibble_3.1.7 ggplot2_3.3.6 tidyverse_1.3.1
##
## loaded via a namespace (and not attached):
## [1] tidytuesdayR_1.0.2 httr_1.4.3 sass_0.4.1 bit64_4.0.5
## [5] vroom_1.5.7 jsonlite_1.8.0 here_1.0.1 modelr_0.1.8
## [9] bslib_0.3.1 assertthat_0.2.1 highr_0.9 selectr_0.4-2
## [13] cellranger_1.1.0 yaml_2.3.5 pillar_1.7.0 backports_1.4.1
## [17] glue_1.6.2 digest_0.6.29 gridtext_0.1.4 rvest_1.0.2
## [21] snakecase_0.11.0 colorspace_2.0-3 htmltools_0.5.2 pkgconfig_2.0.3
## [25] broom_0.8.0 haven_2.5.0 tzdb_0.3.0 generics_0.1.2
## [29] farver_2.1.0 usethis_2.1.6 ellipsis_0.3.2 withr_2.5.0
## [33] cli_3.3.0 magrittr_2.0.3 crayon_1.5.1 readxl_1.4.0
## [37] evaluate_0.15 fs_1.5.2 fansi_1.0.3 xml2_1.3.3
## [41] tools_4.2.0 hms_1.1.1 lifecycle_1.0.1 munsell_0.5.0
## [45] reprex_2.0.1 compiler_4.2.0 jquerylib_0.1.4 rlang_1.0.2
## [49] grid_4.2.0 rstudioapi_0.13 labeling_0.4.2 rmarkdown_2.14
## [53] gtable_0.3.0 DBI_1.1.2 curl_4.3.2 R6_2.5.1
## [57] lubridate_1.8.0 knitr_1.39 fastmap_1.1.0 bit_4.0.4
## [61] utf8_1.2.2 rprojroot_2.0.3 stringi_1.7.6 parallel_4.2.0
## [65] Rcpp_1.0.8.3 vctrs_0.4.1 dbplyr_2.2.0 tidyselect_1.1.2
## [69] xfun_0.31